home *** CD-ROM | disk | FTP | other *** search
/ Aminet 8 / Aminet 8 (1995)(GTI - Schatztruhe)[!][Oct 1995].iso / Aminet / dev / lang / smalltlk.lha / Smalltalk3.09 / src / collect.st < prev    next >
Text File  |  1995-08-26  |  14KB  |  581 lines
  1. *
  2. * Little Smalltalk, version 3
  3. * Written by Tim Budd, Oregon State University, July 1988
  4. *
  5. * methods for Collection classes
  6. *
  7. Class Link Object key value nextLink
  8. Class Collection Magnitude
  9. Class    IndexedCollection Collection
  10. Class       Array IndexedCollection
  11. Class          ByteArray Array
  12. Class             String ByteArray
  13. Class       Dictionary IndexedCollection hashTable
  14. Class    Interval Collection lower upper step
  15. Class    List Collection links
  16. Class       Set List
  17. *
  18. Methods Array 'all'
  19.     < coll
  20.         (coll isKindOf: Array)
  21.             ifTrue: [ self with: coll 
  22.                    do: [:x :y | (x = y) ifFalse: 
  23.                           [ ^ x < y ]].
  24.                   ^ self size < coll size ]
  25.             ifFalse: [ ^ super < coll ]
  26. |
  27.     = coll
  28.         (coll isKindOf: Array)
  29.             ifTrue: [ (self size = coll size)
  30.                     ifFalse: [ ^ false ].
  31.                   self with: coll
  32.                     do: [:x :y | (x = y) 
  33.                         ifFalse: [ ^ false ] ]. 
  34.                  ^ true ]
  35.             ifFalse: [ ^ super = coll ]
  36. |
  37.     at: index put: value
  38.         (self includesKey: index)
  39.             ifTrue: [ self basicAt: index put: value ]
  40.             ifFalse: [ smalltalk error: 
  41.                 'illegal index to at:put: for array' ]
  42. |
  43.     binaryDo: aBlock
  44.         (1 to: self size) do:
  45.             [:i | aBlock value: i value: (self at: i) ]
  46. |
  47.     collect: aBlock        | s newArray |
  48.         s <- self size.
  49.         newArray <- Array new: s.
  50.         (1 to: s) do: [:i | newArray at: i put: 
  51.             (aBlock value: (self at: i))].
  52.         ^ newArray
  53. |
  54.     copyFrom: low to: high    | newArray newlow newhigh |
  55.         newlow <- low max: 1.
  56.         newhigh <- high min: self size.
  57.         newArray <- self class new: (0 max: newhigh - newlow + 1).
  58.         (newlow to: newhigh)
  59.             do: [:i |  newArray at: ((i - newlow) + 1)
  60.                     put: (self at: i) ].
  61.         ^ newArray
  62. |
  63.     deepCopy
  64.         ^ self deepCopyFrom: 1 to: self size
  65. |
  66.     deepCopyFrom: low to: high    | newArray newlow newhigh |
  67.         newlow <- low max: 1.
  68.         newhigh <- high min: self size.
  69.         newArray <- self class new: (0 max: newhigh - newlow + 1).
  70.         (newlow to: newhigh)
  71.             do: [:i |  newArray at: ((i - newlow) + 1)
  72.                     put: (self at: i) copy ].
  73.         ^ newArray
  74. |
  75.     do: aBlock
  76.         (1 to: self size) do:
  77.             [:i | aBlock value: (self at: i) ]
  78. |
  79.     exchange: a and: b    | temp |
  80.         temp <- self at: a.
  81.         self at: a put: (self at: b).
  82.         self at: b put: temp
  83. |
  84.     grow: aValue    | s newArray |
  85.         s <- self size.
  86.         newArray <- Array new: s + 1.
  87.         (1 to: s) do: [:i | newArray at: i put: (self at: i)].
  88.         newArray at: s+1 put: aValue.
  89.         ^ newArray
  90. |
  91.     includesKey: index
  92.         ^ index between: 1 and: self size
  93. |
  94.     new
  95.         ^ smalltalk error: 'arrays and strings cannot be created using new'
  96. |
  97.     reverseDo: aBlock
  98.         (self size to: 1 by: -1) do:
  99.             [:i | aBlock value: (self at: i) ]
  100. |
  101.     select: aCond    | newList |
  102.         newList <- List new.
  103.         self do: [:i | (aCond value: i) ifTrue: [newList addLast: i]].
  104.         ^ newList asArray
  105. |
  106.     shallowCopy
  107.         ^ self copyFrom: 1 to: self size
  108. |
  109.     size
  110.         ^ self basicSize
  111. |
  112.     with: newElement    | s newArray |
  113.         s <- self size.
  114.         newArray <- Array new: (s + 1).
  115.         (1 to: s) do: [:i | newArray at: i put: (self at: i) ].
  116.         newArray at: s+1 put: newElement.
  117.         ^ newArray
  118. |
  119.     with: coll do: aBlock
  120.         (1 to: (self size min: coll size))
  121.             do: [:i | aBlock value: (self at: i) 
  122.                     value: (coll at: i) ]
  123. |
  124.     with: coll ifAbsent: z do: aBlock    | xsize ysize |
  125.         xsize <- self size.
  126.         ysize <- coll size.
  127.         (1 to: (xsize max: ysize))
  128.             do: [:i | aBlock value:
  129.               (i <= xsize ifTrue: [ self at: i ] ifFalse: [ z ])
  130.               value:
  131.               (i <= ysize ifTrue: [ coll at: i ] ifFalse: [ z ])]
  132. ]
  133. Methods ByteArray 'all'
  134.     asString
  135.         <22 self String>
  136. |
  137.     basicAt: index put: value
  138.         ^ ((value isMemberOf: Integer) and: [value between: 0 and: 255])
  139.             ifTrue: [ <32 self index value > ]
  140.             ifFalse: [ value print. smalltalk error: 
  141.                 'assign illegal value to ByteArray']
  142. |
  143.     basicAt: index
  144.         ^ <26 self index>
  145. |
  146.     size: value
  147.         ^ <22 <59 value> ByteArray>
  148. ]
  149. Methods Collection 'all'
  150.     < coll
  151.         (coll respondsTo: #includes:)
  152.             ifFalse: [ ^ smalltalk error:
  153.                   'collection compared to non collection'].
  154.         self do: [:x | ((self occurrencesOf: x) < 
  155.             (coll occurrencesOf: x))ifFalse: [ ^ false ]].
  156.         coll do: [:x | (self includes: x) ifFalse: [ ^ true ]].
  157.         ^ false
  158. |
  159.     = coll
  160.         self do: [:x | (self occurrencesOf: x) = 
  161.                 (coll occurrencesOf: x) ifFalse: [ ^ false ] ].
  162.         ^ true
  163. |
  164.     asArray        | newArray i |
  165.         newArray <- Array new: self size.
  166.         i <- 0.
  167.         self do: [:x | i <- i + 1. newArray at: i put: x].
  168.         ^ newArray
  169. |
  170.     asByteArray    | newArray i |
  171.         newArray <- ByteArray new size: self size.
  172.         i <- 0.
  173.         self do: [:x | i <- i + 1. newArray at: i put: x].
  174.         ^ newArray
  175. |
  176.     asSet
  177.         ^ Set new addAll: self
  178. |
  179.     asString
  180.         ^ self asByteArray asString
  181. |
  182.     display
  183.         self do: [:x | x print ]
  184. |
  185.     includes: value
  186.         self do: [:x | (x = value) ifTrue: [ ^ true ] ].
  187.         ^ false
  188. |
  189.     inject: thisValue into: binaryBlock     | last |
  190.         last <- thisValue.
  191.         self do: [:x | last <- binaryBlock value: last value: x].
  192.         ^ last
  193. |
  194.     isEmpty 
  195.         ^ self size == 0
  196. |
  197.     occurrencesOf: anObject
  198.         ^ self inject: 0
  199.                into: [:x :y | (y = anObject) 
  200.                      ifTrue: [x + 1]
  201.                      ifFalse: [x] ]
  202. |
  203.     printString
  204.         ^ ( self inject: self class printString , ' ('
  205.              into: [:x :y | x , ' ' , y printString]), ' )'
  206. |
  207.     size
  208.         ^ self inject: 0 into: [:x :y | x + 1]
  209. |
  210.     sort: aBlock
  211.         ^ self inject: List new
  212.             into: [:x :y | x add: y ordered: aBlock. x]
  213. |
  214.     sort
  215.         ^ self sort: [:x :y | x < y ]
  216. ]
  217. Methods Dictionary 'all'
  218.     new
  219.         hashTable <- Array new: 39
  220. |
  221.     hash: aKey
  222.         ^ 3 * ((aKey hash) rem: ((hashTable size) quo: 3))
  223. |
  224.     at: aKey ifAbsent: exceptionBlock    | hashPosition  link |
  225.  
  226.         hashPosition <- self hash: aKey.
  227.         ((hashTable at: hashPosition + 1) = aKey)
  228.             ifTrue: [ ^ hashTable at: hashPosition + 2].
  229.         link <- hashTable at: hashPosition + 3.
  230.         ^ (link notNil)
  231.             ifTrue: [ link at: aKey ifAbsent: exceptionBlock ]
  232.             ifFalse: exceptionBlock
  233. |
  234.     at: aKey put: aValue            | hashPosition link |
  235.  
  236.         hashPosition <- self hash: aKey.
  237.         ((hashTable at: hashPosition + 1) isNil)
  238.            ifTrue: [ hashTable at: hashPosition + 1 put: aKey ].
  239.         ((hashTable at: hashPosition + 1) = aKey)
  240.            ifTrue: [ hashTable at: hashPosition + 2 put: aValue ]
  241.            ifFalse: [ link <- hashTable at: hashPosition + 3.
  242.             (link notNil)
  243.                 ifTrue: [ link at: aKey put: aValue ]
  244.                 ifFalse: [ hashTable at: hashPosition + 3
  245.                     put: (Link new; key: aKey; value: aValue)]]
  246. |
  247.     binaryDo: aBlock
  248.         (1 to: hashTable size by: 3) do:
  249.             [:i | (hashTable at: i) notNil
  250.                 ifTrue: [ aBlock value: (hashTable at: i)
  251.                         value: (hashTable at: i+1) ].
  252.                   (hashTable at: i+2) notNil
  253.                 ifTrue: [ (hashTable at: i+2) 
  254.                         binaryDo: aBlock ] ]
  255. |
  256.     display
  257.         self binaryDo: [:x :y | (x printString , ' -> ', 
  258.                     y printString ) print ]
  259. |
  260.     includesKey: aKey
  261.         " look up, but throw away result "
  262.         self at: aKey ifAbsent: [ ^ false ].
  263.         ^ true
  264. |
  265.     removeKey: aKey
  266.         ^ self removeKey: aKey
  267.             ifAbsent: [ smalltalk error: 'remove key not found']
  268. |
  269.     removeKey: aKey ifAbsent: exceptionBlock
  270.         ^ (self includesKey: aKey)
  271.             ifTrue: [ self basicRemoveKey: aKey ]
  272.             ifFalse: exceptionBlock
  273. |
  274.     basicRemoveKey: aKey        | hashPosition link |
  275.         hashPosition <- self hash: aKey.
  276.         ((hashTable at: hashPosition + 1) = aKey)
  277.             ifTrue: [ hashTable at: hashPosition + 1 put: nil.
  278.                   hashTable at: hashPosition + 2 put: nil]
  279.             ifFalse: [ link <- hashTable at: hashPosition + 3.
  280.                 (link notNil)
  281.                     ifTrue: [ hashTable at: hashPosition + 3
  282.                             put: (link removeKey: aKey) ]]
  283. ]
  284. Methods IndexedCollection 'all'
  285.     addAll: aCollection
  286.         aCollection binaryDo: [:i :x | self at: i put: x ]
  287. |
  288.     asArray    
  289.         ^ Array new: self size ; addAll: self
  290. |
  291.     asDictionary
  292.         ^ Dictionary new ; addAll: self
  293. |
  294.     at: aKey
  295.         ^ self at: aKey 
  296.             ifAbsent: [ smalltalk error: 'index to at: illegal' ]
  297. |
  298.     at: index ifAbsent: exceptionBlock
  299.          ^ (self includesKey: index)
  300.             ifTrue: [ self basicAt: index ]
  301.             ifFalse: exceptionBlock
  302. |
  303.     binaryInject: thisValue into: aBlock     | last |
  304.         last <- thisValue.
  305.         self binaryDo: [:i :x | last <- aBlock value: last 
  306.                         value: i value: x].
  307.         ^ last
  308. |
  309.     collect: aBlock
  310.         ^ self binaryInject: Dictionary new
  311.             into: [:s :i :x | s at: i put: (aBlock value: x).  s]
  312. |
  313.     do: aBlock
  314.         self binaryDo: [:i :x | aBlock value: x ]
  315. |
  316.     keys
  317.         ^ self binaryInject: Set new 
  318.             into: [:s :i :x | s add: i ]
  319. |
  320.     indexOf: aBlock
  321.         ^ self indexOf: aBlock
  322.             ifAbsent: [ smalltalk error: 'index not found']
  323. |
  324.     indexOf: aBlock ifAbsent: exceptionBlock
  325.         self binaryDo: [:i :x | (aBlock value: x)
  326.                 ifTrue: [ ^ i ] ].
  327.         ^ exceptionBlock value
  328. |
  329.     select: aBlock
  330.         ^ self binaryInject: Dictionary new
  331.             into: [:s :i :x | (aBlock value: x)
  332.                     ifTrue: [ s at: i put: x ]. s ]
  333. |
  334.     values
  335.         ^ self binaryInject: List new
  336.             into: [:s :i :x | s add: x ]
  337. ]
  338. Methods Interval 'all'
  339.     do: aBlock        | current |
  340.         current <- lower.
  341.         (step > 0) 
  342.             ifTrue: [ [ current <= upper ] whileTrue:
  343.                     [ aBlock value: current.
  344.                       current <- current + step ] ]
  345.             ifFalse: [ [ current >= upper ] whileTrue:
  346.                     [ aBlock value: current.
  347.                     current <- current + step ] ]
  348. |
  349.     lower: aValue
  350.         lower <- aValue
  351. |
  352.     upper: aValue
  353.         upper <- aValue
  354. |
  355.     step: aValue
  356.         step <- aValue
  357. ]
  358. Methods Link 'all'
  359.     add: newValue whenFalse: aBlock
  360.         (aBlock value: value value: newValue)
  361.             ifTrue: [ (nextLink notNil)
  362.                 ifTrue: [ nextLink <- nextLink add: newValue 
  363.                     whenFalse: aBlock ]
  364.             ifFalse: [ nextLink <- Link new; value: newValue] ]
  365.             ifFalse: [ ^ Link new; value: newValue; link: self ]
  366. |
  367.     at: aKey ifAbsent: exceptionBlock
  368.         (aKey = key)
  369.             ifTrue: [ ^value ]
  370.             ifFalse: [ ^ (nextLink notNil)
  371.                     ifTrue: [ nextLink at: aKey
  372.                             ifAbsent: exceptionBlock ]
  373.                     ifFalse: exceptionBlock ]
  374. |
  375.     at: aKey put: aValue
  376.         (aKey = key)
  377.             ifTrue: [ value <- aValue ]
  378.             ifFalse: [ (nextLink notNil)
  379.                 ifTrue: [ nextLink at: aKey put: aValue]
  380.                 ifFalse: [ nextLink <- Link new;
  381.                         key: aKey; value: aValue] ]
  382. |
  383.     binaryDo: aBlock
  384.         aBlock value: key value: value.
  385.         (nextLink notNil)
  386.             ifTrue: [ nextLink binaryDo: aBlock ]
  387. |
  388.     key: aKey
  389.         key <- aKey
  390. |
  391.     includesKey: aKey
  392.         (key = aKey)
  393.             ifTrue: [ ^ true ].
  394.         (nextLink notNil)
  395.             ifTrue: [ ^ nextLink includesKey: aKey ]
  396.             ifFalse: [ ^ false ]
  397. |
  398.     link: aLink
  399.         nextLink <- aLink
  400. |
  401.     next
  402.         ^ nextLink
  403. |
  404.     removeKey: aKey
  405.         (aKey = key)
  406.             ifTrue: [ ^ nextLink ]
  407.             ifFalse: [ (nextLink notNil)
  408.                 ifTrue: [ nextLink <- nextLink removeKey: aKey]]
  409. |
  410.     removeValue: aValue
  411.         (aValue = value)
  412.             ifTrue: [ ^ nextLink ]
  413.             ifFalse: [ (nextLink notNil)
  414.                 ifTrue: [ nextLink <- nextLink removeValue: aValue]]
  415. |
  416.     reverseDo: aBlock
  417.         (nextLink notNil)
  418.             ifTrue: [ nextLink reverseDo: aBlock ].
  419.         aBlock value: value
  420. |
  421.     size
  422.         (nextLink notNil)
  423.             ifTrue: [ ^ 1 + nextLink size]
  424.             ifFalse: [ ^ 1 ]
  425. |
  426.     value: aValue
  427.         value <- aValue
  428. |
  429.     value
  430.         ^ value
  431. ]
  432. Methods List 'all'
  433.     add: aValue
  434.         ^ self addLast: aValue
  435. |
  436.     add: aValue ordered: aBlock
  437.         (links isNil)
  438.             ifTrue: [ self addFirst: aValue]
  439.             ifFalse: [ links <- links add: aValue 
  440.                     whenFalse: aBlock ]
  441. |
  442.     addAll: aValue
  443.         aValue do: [:x | self add: x ]
  444. |
  445.     addFirst: aValue
  446.         links <- Link new; value: aValue; link: links
  447. |
  448.     addLast: aValue
  449.         (links isNil)
  450.             ifTrue: [ self addFirst: aValue ]
  451.             ifFalse: [ links add: aValue whenFalse: [ :x :y | true ] ]
  452. |
  453.     collect: aBlock
  454.         ^ self inject: self class new
  455.                into: [:x :y | x add: (aBlock value: y). x ]
  456. |
  457.     links
  458.         ^ links  "used to walk two lists in parallel "
  459. |
  460.     reject: aBlock          
  461.         ^ self select: [:x | (aBlock value: x) not ]
  462. |
  463.     reverseDo: aBlock
  464.         (links notNil)
  465.             ifTrue: [ links reverseDo: aBlock ]
  466. |
  467.     select: aBlock          
  468.         ^ self inject: self class new
  469.                into: [:x :y | (aBlock value: y) 
  470.                     ifTrue: [x add: y]. x]
  471. |
  472.     do: aBlock
  473.         (links notNil)
  474.             ifTrue: [ links binaryDo: [:x :y | aBlock value: y]]
  475. |
  476.     first
  477.         ^ (links notNil)
  478.             ifTrue: links
  479.             ifFalse: [ smalltalk error: 'first on empty list']
  480. |
  481.     removeFirst
  482.         self remove: self first
  483. |
  484.     remove: value
  485.         (links notNil)
  486.             ifTrue: [ links <- links removeValue: value ]
  487. |
  488.     size
  489.         (links isNil)
  490.             ifTrue: [ ^ 0 ]
  491.             ifFalse: [ ^ links size ]
  492. ]
  493. Methods Set 'all'
  494.     add: value
  495.         (self includes: value)
  496.             ifFalse: [ self addFirst: value ]
  497. ]
  498. Methods String 'all'
  499.     , value
  500.         (value isMemberOf: String)
  501.             ifTrue: [ (self size + value size) > 2000
  502.                     ifTrue: [ 'string too large' print. ^ self ]
  503.                     ifFalse: [ ^ <24 self value> ] ]
  504.             ifFalse: [ ^ self , value asString ]
  505. |
  506.     = value
  507.         (value isKindOf: String)
  508.             ifTrue: [ ^ super = value ]
  509.             ifFalse: [ ^ false ]
  510. |
  511.     < value
  512.         (value isKindOf: String)
  513.             ifTrue: [ ^ super < value ]
  514.             ifFalse: [ ^ false ]
  515. |
  516.     asByteArray    | newArray i |
  517.         newArray <- ByteArray new size: self size.
  518.         i <- 0.
  519.         self do: [:x | i <- i + 1. newArray at: i put: x asInteger].
  520.         ^ newArray
  521. |
  522.     asInteger
  523.         ^ self inject: 0 into: [:x :y | x * 10 + y digitValue ]
  524. |
  525.     basicAt: index
  526.         ^  (super basicAt: index) asCharacter
  527. |
  528.     basicAt: index put: aValue
  529.         (aValue isMemberOf: Char)
  530.             ifTrue: [ super basicAt: index put: aValue asInteger ]
  531.             ifFalse: [ smalltalk error:
  532.                 'cannot put non Char into string' ]
  533. |
  534.     asSymbol
  535.         ^ <83 self>
  536. |
  537.     copy
  538.         " catenation makes copy automatically "
  539.         ^ '',self
  540. |
  541.     copyFrom: position1 to: position2
  542.         ^ <33 self position1 position2>
  543. |
  544.     hash
  545.         ^ <82 self>
  546. |
  547.     printString
  548.         ^ '''' , self, ''''
  549. |
  550.     size
  551.         ^ <81 self>
  552. |
  553.     words: aBlock    | text index list |
  554.         list <- List new.
  555.         text <- self.
  556.         [ text <- text copyFrom: 
  557.             (text indexOf: aBlock ifAbsent: [ text size + 1])
  558.                 to: text size.
  559.           text size > 0 ] whileTrue:
  560.             [ index <- text 
  561.                 indexOf: [:x | (aBlock value: x) not ]
  562.                 ifAbsent: [ text size + 1].
  563.               list addLast: (text copyFrom: 1 to: index - 1).
  564.               text <- text copyFrom: index to: text size ].
  565.         ^ list asArray
  566. |
  567.     value
  568.         " evaluate self as an expression "
  569.         ^ ( '^ [ ', self, ' ] value' ) execute
  570. |
  571.     execute    | meth |
  572.         " execute self as body of a method "
  573.         meth <- Method new; text: 'compile ', self.
  574.         (meth compileWithClass: Object)
  575.             ifTrue: [ ^ meth executeWith: #(0) ].
  576.         ^ nil
  577. |
  578.     dosCommand
  579.         ^ <88 self>
  580. ]
  581.